# Set methods for the ProtocolApplication class.
# Author: Bastian R. Angermann
###############################################################################

#' remove all input data sets that are in the ignorelist.
#' 
#' Used to ignore certain input data sets that were flagged in previous analysis steps.
#' @param  inputData the set of input data that was defined in the protocolApplication.
#' @param  ignoreList list of filenames that should be ignored
applyIgnoreList <- function(inputData,ignoreList)
{
    theInputData <- list()
    for (fileList in inputData)        
    {
        if (! (unlist(fileList) %in% unlist(c(ignoreList))) )
            theInputData  <- insert(theInputData,list(fileList))   
    }
    if (length(theInputData)==0)
        submitToLog("Nothing to process. Ignore list contains the entire input","Error")
    return(theInputData)
}

# see documentation below
setGeneric(name=".setInputData",
        def=function(object, dataLocationFile) standardGeneric(".setInputData") )
## ===========================================================================
## Method for setting and validating inputData
## ---------------------------------------------------------------------------
setMethod(".setInputData", signature(object="ProtocolApplication", dataLocationFile="character"), 
    function(object,dataLocationFile){
    object@.inputData <- readCsvFileList(dataLocationFile)
    object@.inputData <- applyIgnoreList(object@.inputData,object@ignoreList)
    object
})
setMethod(".setInputData", signature(object="ProtocolApplication", dataLocationFile="NULL"), 
    function(object,dataLocationFile){
    object@.inputData <- list()
    object
})
setMethod(".setInputData", signature(object="ProtocolApplication", dataLocationFile="list"), 
    function(object,dataLocationFile){
    dataLocations <- dataLocationFromOutputFileList(dataLocationFile)
    object@.inputData <- fileListFromDataframe(dataLocations)
    object@.inputData <- applyIgnoreList(object@.inputData,object@ignoreList)
    object
})

setMethod(".setInputData", signature(object="ProtocolApplication", dataLocationFile="RDataFile"), 
    function(object,dataLocationFile){      
    object@.inputData <- list(lapply(dataLocationFile,function(x) {attr(x,which="Type") <-"RDATA";return(x)} ))
    object
})

setMethod(".setInputData", signature(object="ProtocolApplication", dataLocationFile="Direct"), 
            function(object,dataLocationFile){      
                object@.inputData <- dataLocationFile
                object
        })

setMethod(".setInputData", signature(object="ProtocolApplication", dataLocationFile="PassthroughFileList"), 
    function(object,dataLocationFile){
    tempFileList <- readCsvFileList(dataLocationFile)
    tempFileList <- applyIgnoreList(tempFileList, object@ignoreList)
    # save tempfileList
    tempfile <- dataLocationFile
    objectsWithSameName <- eval(substitute(getAnywhere(x), list(x=tempfile)))
    while (length(objectsWithSameName$objs)!=0)
    {
        tempfile <- paste(getuuid(),dataLocationFile,sep="")
        objectsWithSameName <- eval(substitute(getAnywhere(x), list(x=tempfile)))
    }
    eval(substitute(assign(theName, tempFileList, globalenv() ),list(theName=tempfile) ) )
    
    object@.inputData <- list(list(tempfile)) 
    attr(object@.inputData[[1]][[1]],which="Type") <- "INTERNAL"
    object
})



# see documentation below
setGeneric(name=".setParameterValuesFromCsvFile",
        def=function(object, parameterFile) standardGeneric(".setParameterValuesFromCsvFile") )
## ===========================================================================
## Method for setting and validating parameterValues
## ---------------------------------------------------------------------------

setMethod(".setParameterValuesFromCsvFile", signature(object="ProtocolApplication", parameterFile="character"), 
    function(object, parameterFile){
    object@parameterValues <- readCsvSettings(parameterFile)
    object
})
setMethod(".setParameterValuesFromCsvFile", signature(object="ProtocolApplication", parameterFile="NULL"), 
    function(object, parameterFile){
    object@parameterValues <-list()
    object
})

# see documentation below
setGeneric(name=".setOutputData",
        def=function(object,outputDataLocation) standardGeneric(".setOutputData") )
## ===========================================================================
## Method for setting and validating outputData
## ---------------------------------------------------------------------------
setMethod(".setOutputData", signature(object="ProtocolApplication",outputDataLocation="character"), 
    function(object,outputDataLocation){
    # TODO: sanity test    
    object@outputData <- outputDataLocation
    object
})
setMethod(".setOutputData", signature(object="ProtocolApplication",outputDataLocation="NULL"), 
    function(object,outputDataLocation){
    object
})

# see documentation below
setGeneric(name=".setAction",
        def=function(object,actionName) standardGeneric(".setAction") )
## ===========================================================================
## Method for setting and validating actions
## ---------------------------------------------------------------------------
setMethod(".setAction",signature(object="ProtocolApplication",actionName="character"), function(object,actionName){
    name <- actionName
    objectsWithSameName <- eval(substitute(getAnywhere(x), list(x=name)))
    # test if an action with the specified name is already defined
    nObjects <- length(objectsWithSameName$objs)
    if ( nObjects == 0 ) # non defined try to load an action form disk.
    {  
        source(name)
        symbolsInEnvironment <- ls()
        if (length(symbolsInEnvironment)!=1 ) submitToLog("Invalid action file more than one object defined", "Error")
        if ( isSaneActionImplementation( symbolsInEnvironment[[1]] ) ) 
        { 
            object@.action <- symbolsInEnvironment[[1]]
            attr(object@.action,which="name") <- name
        }
        else
            submitToLog("Action failed sanity test.", "Error")
    } else if (  (nObjects==2) & (objectsWithSameName$dups[[2]]==TRUE)  ) # FIXME test length of dups first
    { # found one object and its duplicate, test it.
        if (typeof(objectsWithSameName$objs[[1]]) == "closure")
        { 
            if ( isSaneActionImplementation( objectsWithSameName$objs[[1]] ) == TRUE )
            {  
                object@.action <- objectsWithSameName$objs[[1]]
                attr(object@.action,which="name") <- name
            }
            else
            {  
                submitToLog("Action failed sanity test.", "Error")
            }
        }
        else
            submitToLog(paste("Action",objectsWithSameName$name,"is defined in an environment but not a closure"),
                        "Error" )
    } else
        submitToLog(paste("More than one object with name",objectsWithSameName$name,"is defined"),
                    "Error")
    object
})

